unit TCPIPTools;

interface

uses
  Windows, SysUtils, Classes, WinSock;

function GetMacAddr(const IPAddress: string): string;
procedure GetLocalIPs( IPs: TStrings ); overload;
function GetLocalIPs: string; overload;
function GetFirstLocalIP: string;

implementation

uses
  StrTools;

const
  iphlpapilib = 'IPHLPAPI.DLL';

function SendArp(ipaddr:ulong;
                 temp:dword;
                 ulmacaddr:pointer;
                 ulmacaddrleng:pointer) : DWord; StdCall; external iphlpapilib name 'SendARP';

function GetMacAddr(const IPAddress: string): string;
var
  lDestIP:ulong;
  lMacAddr:array[0..5] of byte;
  lPhyAddrLen:ulong;
  GInitData : TWSADATA;
begin
  if wsastartup($101,GInitData)=0 then
  begin
    lDestIP:=inet_addr(PChar(IPAddress));
    lPhyAddrLen:=length(lMacAddr);
    SendARP(lDestIP,0,@lMacAddr,@lPhyAddrLen);
    Result:=format('%2.2x-%2.2x-%2.2x-%2.2x-%2.2x-%2.2x',[lMacAddr[0],lMacAddr[1],lMacAddr[2],lMacAddr[3],lMacAddr[4],lMacAddr[5]]);
    wsacleanup;
  end
  else result := '';
end;

procedure GetLocalIPs( IPs: TStrings );
type
  TaPInAddr = array [0..255] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe       : PHostEnt;
  pptr      : PaPInAddr;
  Buffer    : array [0..63] of char;
  i         : integer;
  GInitData : TWSADATA;
begin
  if wsastartup($101,GInitData)=0 then
  begin
    GetHostName(Buffer,SizeOf(Buffer));
    phe := GetHostByName(buffer);
    if assigned(phe) then
    begin
      pptr := PaPInAddr(Phe^.h_addr_list);
      i := 0;
      while pptr^[i]<>nil do
      begin
        IPs.Add(StrPas(inet_ntoa(pptr^[i]^)));
        inc(i);
      end;
    end;
    wsacleanup;
  end;
end;

function GetLocalIPs: string;
var
  l : TStringList;
begin
  l := TStringList.Create;
  GetLocalIPs(l);
  result := StringsToSepStr(l,',');
  l.Free;
end;

function GetFirstLocalIP: string;
var
  l : TStringList;
begin
  l := TStringList.Create;
  GetLocalIPs(l);
  if l.Count>0 then result := l[0]
               else result := '';
  l.Free;
end;

end.
